home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / prnmain / prnmain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  32.3 KB  |  1,115 lines
  1.  
  2. {******* prnMain.pas *******}
  3.  
  4. unit Prnmain;
  5.  
  6. interface
  7.  
  8. uses
  9.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  10.   Forms, Dialogs, StdCtrls, ExtCtrls, Printers;
  11.  
  12. const
  13.   HeaderLines = 5;                        { Number of allowable header lines }
  14.   FooterLines = 5;                        { Number of allowable footer lines }
  15.   Columns = 20;                           { Number of allowable columns }
  16.         
  17. type
  18.   THeaderRecord = Record
  19.  
  20.      Text: String[240];                   { Header text }
  21.      YPosition: Single;                   { Inches from the top }
  22.      Alignment: Integer;                  { 0:Left 1:Center 2:Right }
  23.      FontName: String[80];                { Font name }
  24.      FontSize: Integer;                   { Font size }
  25.      FontStyle: TFontStyles;              { Font style }
  26.      End;
  27.  
  28.   TFooterRecord = Record
  29.      Text: String[240];                   { Footer text }
  30.      YPosition: Single;                   { Inches from the top }
  31.  
  32.      Alignment: Integer;                  { 0:Left 1:Center 2:Right }
  33.      FontName: String[80];                { Font name }
  34.      FontSize: Integer;                   { Font size }
  35.      FontStyle: TFontStyles;              { Font style }
  36.      End;
  37.  
  38.   THeaderCoordinates = Record
  39.      XTop: Single;
  40.      YTop: Single;
  41.      XBottom: Single;
  42.      YBottom: Single;
  43.      Boxed: Boolean;
  44.      Shading: Word;
  45.      LineWidth: Word;
  46.      End;   
  47.  
  48.   TFooterCoordinates = Record
  49.  
  50.      XTop: Single;
  51.      YTop: Single;
  52.      XBottom: Single;
  53.      YBottom: Single;
  54.      Boxed: Boolean;
  55.      Shading: Word;
  56.      LineWidth: Word;
  57.      End;   
  58.  
  59.   TPageNumberRecord = Record
  60.      YPosition: Single;
  61.      Text: String[240];
  62.      Alignment: Word; 
  63.      FontName: String[80];
  64.      FontSize: Word;
  65.      FontStyle: TFontStyles;
  66.      End;
  67.  
  68.   TColumnInformationRecord = Record
  69.      XPosition: Single;
  70.      Length: Single;
  71.      End;
  72.  
  73.   TPrintObject = class
  74.  
  75.      private
  76.         TopMargin: Integer;               { Top margin in pixels }
  77.         BottomMargin: Integer;            { Bottom margin in pixels }
  78.         LeftMargin: Integer;              { Left margin in pixels }
  79.         RightMargin: Integer;             { Right margin in pixels }
  80.         PixelsPerInchVertical: Integer;   { Number of pixels per inch along Y axis }
  81.         PixelsPerInchHorizontal: Integer; { Number of pixels per inch along X axis }
  82.         TotalPageWidthPixels: Integer;    { Full width of page in pixels - includes gutters }
  83.  
  84.         TotalPageHeightPixels: Integer;   { Full height of page in pixels - includes gutters }
  85.         TotalPageHeightInches: Single;    { Height of page in inches }
  86.         TotalPageWidthInches: Single;     { Width of page in inches }
  87.         GutterLeft: Integer;              { Unprintable area on left }
  88.         GutterRight: Integer;             { Unprintable area on right }
  89.         GutterTop: Integer;               { Unprintable area on top }
  90.         GutterBottom: Integer;            { Unprintable area on bottom }
  91.  
  92.         DetailTop: Single;                { Inches from the top where the detail section starts }
  93.         DetailBottom: Single;             { Inches from the top where the detail section ends }
  94.         LastYPosition: Single;            { The Y position where the last write occurred }
  95.         AutoPaging: Boolean;              { Are new pages automatically generated? }
  96.         CurrentTab: Single;               { The value of the current tab }
  97.         CurrentFontName: String[30];
  98.  
  99.         CurrentFontSize: Integer;
  100.         CurrentFontStyle: TFontStyles;
  101.         TextMetrics: TTextMetric;
  102.         Header: Array[1..HeaderLines] of THeaderRecord;
  103.         Footer: Array[1..FooterLines] of TFooterRecord;
  104.         ColumnInformation: Array[1..Columns] of TColumnInformationRecord;
  105.         PageNumber: TPageNumberRecord;
  106.         HeaderCoordinates: THeaderCoordinates;
  107.         FooterCoordinates: TFooterCoordinates;
  108.         function CalculateLineHeight: Integer;
  109.  
  110.         function InchesToPixelsHorizontal( Inches: Single ): Integer;
  111.         function InchesToPixelsVertical( Inches: Single ): Integer;
  112.         function PixelsToInchesHorizontal( Pixels: Integer ): Single;
  113.         function PixelsToInchesVertical( Pixels: Integer ): Single;
  114.         function LinesToPixels( Line:Integer ): Integer;
  115.         procedure CalculateMeasurements;
  116.         procedure _DrawBox( XTop:Word; YTop:Word; XBottom:Word; YBottom:Word; LineWidth:Word; Shading:Word );
  117.  
  118.      public
  119.         procedure Start;
  120.         procedure Quit;
  121.         procedure Abort;
  122.         procedure SetMargins( Top:Single; Bottom:Single; Left:Single; Right:Single );
  123.         procedure SetFontInformation( Name:String; Size:Word; Style: TFontStyles );
  124.         procedure WriteLine( X:Single; Y:Single; Text:String );
  125.         procedure WriteLineRight( Y:Single; Text:String );
  126.         procedure WriteLineCenter( Y:Single; Text:String );
  127.         procedure WriteLineColumnRight( ColumnNumber:Word; Y:Single; Text:String );
  128.  
  129.         procedure WriteLineColumnCenter( ColumnNumber:Word; Y:Single; Text:String );
  130.         procedure DrawLine( TopX:Single; TopY:Single; BottomX:Single; BottomY:Single; LineWidth:Word );
  131.         procedure SetLineWidth( Width:Word );
  132.         function  GetLineWidth: Word;
  133.         procedure SetTab( Inches:Single );
  134.         procedure NewPage;
  135.         function  GetLinesPerPage: Integer;
  136.         procedure GetPixelsPerInch( var X:Word; var Y:Word );
  137.         procedure GetPixelsPerPage( var X:Word; var Y:Word );
  138.  
  139.         procedure GetGutter( var Top:Word; var Bottom:Word; var Left:Word; var Right:Word );
  140.         function  GetTextWidth( Text:String ): Integer;
  141.         function  GetLineHeightPixels: Word;
  142.         function  GetLineHeightInches: Single;
  143.         function  GetPageNumber:Integer;
  144.         function  GetColumnsPerLine: Integer;
  145.         procedure SetOrientation( Orient: TPrinterOrientation );
  146.         procedure SetHeaderInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word; 
  147.  
  148.                      FontName:String; FontSize: Word; FontStyle: TFontStyles );
  149.         procedure SetFooterInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word; 
  150.                      FontName:String; FontSize: Word; FontStyle: TFontStyles );
  151.         procedure WriteHeader;
  152.         procedure WriteFooter;
  153.         procedure SaveCurrentFont;
  154.         procedure RestoreCurrentFont;
  155.         procedure SetDetailTopBottom( Top: Single; Bottom: Single );
  156.         procedure SetAutoPaging( Value: Boolean );
  157.  
  158.         procedure SetPageNumberInformation( YPosition:Single; Text:String; Alignment:Word; FontName:String; 
  159.                      FontSize:Word; FontStyle:TFontStyles );
  160.         procedure WritePageNumber;
  161.         procedure WriteLineColumn( ColumnNumber:Word; Y:Single; Text:String );
  162.         procedure DrawBox( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word );
  163.         procedure DrawBoxShaded( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word; Shading:Word );
  164.  
  165.         procedure SetHeaderDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
  166.                   Boxed: Boolean; LineWidth:Word; Shading:Word );
  167.         procedure SetFooterDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
  168.                   Boxed: Boolean; LineWidth:Word; Shading:Word );
  169.         procedure CreateColumn( Number:Word; XPosition:Single; Length:Single );
  170.         procedure SetYPosition( YPosition:Single );
  171.         function  GetYPosition: Single;
  172.  
  173.         procedure NextLine;
  174.         function  GetLinesLeft: Word;
  175.         function  GetLinesInDetailArea: Word;
  176.         procedure SetTopOfPage;
  177.         procedure NewLines( Number:Word );
  178.         function GetFontName: String;
  179.         function GetFontSize: Word;
  180.    End;
  181.  
  182. implementation
  183.  
  184. procedure TPrintObject.Start;
  185.  
  186.    { This function MUST be called first before any other printing function }
  187.  
  188.    var
  189.       Top,Bottom,Left,Right: Single;
  190.       I: Integer;
  191.  
  192.  
  193.    Begin
  194.    Printer.BeginDoc;
  195.  
  196.    AutoPaging := True;
  197.  
  198.    CalculateMeasurements;
  199.  
  200.    PageNumber.Text := '';
  201.  
  202.    Top := PixelsToInchesVertical( GutterTop );
  203.    Bottom := PixelsToInchesVertical( GutterBottom );
  204.    Left := PixelsToInchesHorizontal( GutterLeft );
  205.    Right := PixelsToInchesHorizontal( GutterRight );
  206.    SetMargins( Top,Bottom,Left,Right );
  207.  
  208.    For I := 1 To HeaderLines Do
  209.       Header[I].Text := '';
  210.    HeaderCoordinates.Boxed := False;
  211.    HeaderCoordinates.Shading := 0;
  212.  
  213.    For I := 1 To FooterLines Do
  214.       Footer[I].Text := '';
  215.    FooterCoordinates.Boxed := False;
  216.    FooterCoordinates.Shading := 0;
  217.  
  218.    CurrentTab := 0.0;
  219.  
  220.    LastYPosition := 0.0;
  221.    End;              
  222.  
  223. procedure TPrintObject.Quit;
  224.  
  225.    { 'Quit' must always be called when printing is completed }
  226.  
  227.    Begin
  228.    WriteHeader;
  229.    WriteFooter;
  230.    WritePageNumber;
  231.  
  232.    Printer.EndDoc
  233.    End;
  234.  
  235. procedure TPrintObject.SetMargins( Top:Single; Bottom:Single; Left:Single; Right:Single );
  236.  
  237.  
  238.    { Set the top, bottom, left and right margins in inches }
  239.  
  240.    var
  241.       Value: Single;
  242.       Buffer: String;
  243.  
  244.    Begin
  245.    { If the sum of the left and right margins exceeds the width of the page,
  246.      set the left margin to the value of 'GutterLeft' and set the right
  247.      margin to the value of 'GutterRight' }
  248.    If ( Left + Right >= TotalPageWidthInches ) Then
  249.       Begin
  250.       Left := GutterLeft;
  251.       Right := GutterRight;
  252.       End;
  253.    If ( Left <= 0 ) Then
  254.  
  255.       Left := GutterLeft;
  256.    If ( Right <= 0 ) Then
  257.       Right := GutterRight;
  258.  
  259.    { If the sum of the top and bottom margins exceeds the height of the 
  260.      page, set the top margin to the value of 'GutterTop' and set the 
  261.      bottom margin to the value of 'GutterBottom' }
  262.    If ( Top + Bottom >= TotalPageHeightInches ) Then
  263.       Begin
  264.       Top := GutterTop;
  265.       Bottom := GutterBottom;
  266.       End;
  267.    If ( Top <= 0 ) Then
  268.       Top := GutterTop;
  269.    If ( Bottom <= 0 ) Then
  270.  
  271.       Bottom := GutterBottom;
  272.  
  273.    { Convert everything to pixels }
  274.    TopMargin := InchesToPixelsVertical( Top );
  275.    If ( TopMargin < GutterTop ) Then
  276.       TopMargin := GutterTop;
  277.  
  278.    BottomMargin := InchesToPixelsVertical( Bottom );
  279.    If ( BottomMargin < GutterBottom ) Then
  280.       BottomMargin := GutterBottom;
  281.  
  282.    LeftMargin := InchesToPixelsHorizontal( Left );
  283.    If ( LeftMargin < GutterLeft ) Then
  284.       LeftMargin := GutterLeft;
  285.  
  286.    RightMargin := InchesToPixelsHorizontal( Right );
  287.  
  288.    If ( RightMargin < GutterRight ) Then
  289.       RightMargin := GutterRight;
  290.    End;
  291.  
  292. procedure TPrintObject.WriteLine( X:Single; Y:Single; Text:String );
  293.  
  294.    { Write some text.  The parameters represent inches from the left ('X')
  295.      and top ('Y') margins. }
  296.  
  297.    var
  298.       XPixels: Integer;
  299.       YPixels: Integer;
  300.  
  301.    Begin
  302.    { How many pixels are there in the inches represented by 'X'? }
  303.    If ( X >= 0.0 ) Then
  304.       XPixels := InchesToPixelsHorizontal( X )
  305.  
  306.    Else
  307.       XPixels := LeftMargin;
  308.    If ( XPixels < GutterLeft ) Then
  309.       XPixels := GutterLeft;
  310.  
  311.    { If there is a tab set, increase 'XPixels' by the amount of the tab }
  312.    If ( CurrentTab > 0.0 ) Then
  313.       Inc( XPixels,InchesToPixelsHorizontal(CurrentTab) );
  314.  
  315.    { How many pixels are there in the inches represented by 'Y'? }
  316.    If ( Y > -0.01 ) Then
  317.       { Printing will occur at an absolute location from the top of the 
  318.         page. }
  319.       Begin
  320.       YPixels := InchesToPixelsVertical( Y );
  321.  
  322.       If ( YPixels < GutterTop ) Then
  323.          YPixels := GutterTop;
  324.       If ( YPixels > TotalPageHeightPixels ) Then
  325.          YPixels := TotalPageHeightPixels - GutterBottom;
  326.  
  327.       LastYPosition := Y;
  328.       End;
  329.    If ( Y = -1.0 ) Then
  330.       { Write the text at the next line }
  331.       Begin
  332.       If ( AutoPaging = True ) Then
  333.          Begin
  334.          { If the next line we're going to write to exceeds beyond the 
  335.            bottom of the detail section, issue a new page }
  336.  
  337.          If ( LastYPosition + GetLineHeightInches > DetailBottom ) Then
  338.             NewPage;
  339.          End;
  340.       YPixels := InchesToPixelsVertical( LastYPosition + GetLineHeightInches );
  341.       LastYPosition := LastYPosition + GetLineHeightInches;
  342.       End;
  343.    If ( Y = -2.0 ) Then
  344.       { Write the text on the current line }
  345.       YPixels := InchesToPixelsVertical( LastYPosition );      
  346.  
  347.    Printer.Canvas.TextOut( XPixels-GutterLeft,YPixels-GutterTop,Text );
  348.    End;
  349.  
  350.  
  351. procedure TPrintObject.WriteLineColumn( ColumnNumber:Word; Y:Single; Text:String );
  352.  
  353.    { Write text, left aligned against the column represented by
  354.      'ColumnInformation[ColumnNumber]' }
  355.  
  356.    Begin
  357.    WriteLine( ColumnInformation[ColumnNumber].XPosition,Y,Text );
  358.    End;
  359.  
  360. procedure TPrintObject.WriteLineColumnRight( ColumnNumber:Word; Y:Single; Text:String );
  361.  
  362.    { Write text, right aligned against the column represented by
  363.      'ColumnInformation[ColumnNumber]' }
  364.  
  365.  
  366.    var
  367.       PixelLength: Word;
  368.       StartPixel: Word;
  369.  
  370.    Begin
  371.    { How many pixels does the text in 'Text' require? }
  372.    PixelLength := Printer.Canvas.TextWidth( Text );
  373.  
  374.    { Calculate where printing should start }
  375.    StartPixel := InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].XPosition + 
  376.       ColumnInformation[ColumnNumber].Length ) - PixelLength;
  377.  
  378.    SetTab( 0.0 );
  379.    WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
  380.    SetTab( CurrentTab );
  381.  
  382.    End;
  383.  
  384. procedure TPrintObject.WriteLineRight( Y:Single; Text:String );
  385.  
  386.    { Print a line of text right justified 'Y' inches from the top }
  387.  
  388.    var
  389.       PixelLength: Word;
  390.       StartPixel: Word;
  391.  
  392.    Begin
  393.    { How many pixels does the text in 'Text' require? }
  394.    PixelLength := Printer.Canvas.TextWidth( Text );
  395.  
  396.    { Calculate where printing should start }
  397.    StartPixel := (TotalPageWidthPixels-GutterLeft-GutterRight) - PixelLength;
  398.  
  399.    SetTab( 0.0 );       
  400.  
  401.    WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
  402.    SetTab( CurrentTab );       
  403.    End;
  404.  
  405. procedure TPrintObject.WriteLineCenter( Y:Single; Text:String );
  406.  
  407.    { Print a line of text centered at Y inches from the top }
  408.  
  409.    var
  410.       PixelLength: Integer;
  411.       StartPixel: Integer;
  412.  
  413.    Begin
  414.    { How many pixels does the text in 'Text' require? }
  415.    PixelLength := Printer.Canvas.TextWidth( Text );
  416.  
  417.    { Calculate where printing should start }
  418.    StartPixel := ((GutterLeft+(TotalPageWidthPixels-GutterRight)) Div 2) - (PixelLength Div 2);   
  419.  
  420.  
  421.    SetTab( 0.0 );
  422.    WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
  423.    SetTab( CurrentTab );
  424.    End;
  425.  
  426. procedure TPrintObject.WriteLineColumnCenter( ColumnNumber:Word; Y:Single; Text:String );
  427.  
  428.    { Print a line of text centered within the column number represented by
  429.      'ColumnNumber', at Y inches from the top }
  430.  
  431.    var
  432.       PixelLength: Integer;
  433.       StartPixel: Integer;
  434.       Pixels: Integer;
  435.  
  436.    Begin
  437.    { How many pixels does the text in 'Text' require? }
  438.  
  439.    PixelLength := Printer.Canvas.TextWidth( Text );
  440.  
  441.    { Calculate where printing should start }
  442.    Pixels := InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].Length );
  443.    StartPixel := (InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].Length ) Div 2) +
  444.       InchesToPixelsHorizontal(ColumnInformation[ColumnNumber].XPosition) - (PixelLength Div 2);
  445.  
  446.    SetTab( 0.0 );
  447.    WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
  448.    SetTab( CurrentTab );
  449.  
  450.    End;
  451.  
  452. procedure TPrintObject.DrawLine( TopX:Single; TopY:Single; BottomX:Single; BottomY:Single; LineWidth:Word );
  453.  
  454.    { Draw a line beginning at a particular X,Y coordinate and ending at a 
  455.      particular X,Y coordinate. }
  456.  
  457.    var
  458.       TopXPixels, BottomXPixels, TopYPixels, BottomYPixels: Integer;
  459.  
  460.    Begin
  461.    TopXPixels := InchesToPixelsHorizontal( TopX );
  462.    BottomXPixels := InchesToPixelsHorizontal( BottomX );
  463.    TopYPixels := InchesToPixelsVertical( TopY );
  464.  
  465.    BottomYPixels := InchesToPixelsVertical( BottomY );
  466.  
  467.    Dec( TopXPixels,GutterLeft );
  468.    Dec( BottomXPixels,GutterLeft );
  469.    Dec( TopYPixels,GutterTop );
  470.    Dec( BottomYPixels,GutterTop );
  471.  
  472.    Printer.Canvas.Pen.Width := LineWidth;
  473.  
  474.    Printer.Canvas.MoveTo( TopXPixels,TopYPixels );
  475.    Printer.Canvas.LineTo( BottomXPixels,BottomYPixels );
  476.    End;
  477.  
  478. procedure TPrintObject.SetFontInformation( Name:String; Size:Word; Style: TFontStyles );
  479.  
  480.    { Change the current font information }
  481.  
  482.  
  483.    Begin
  484.    Printer.Canvas.Font.Name := Name;
  485.    Printer.Canvas.Font.Size := Size;
  486.    Printer.Canvas.Font.Style := Style;
  487.  
  488.    CalculateMeasurements;
  489.    End;
  490.  
  491. function TPrintObject.GetFontName: String;
  492.  
  493.    { Return the current font name }
  494.  
  495.    Begin
  496.    Result := Printer.Canvas.Font.Name;
  497.    End;
  498.  
  499. function TPrintObject.GetFontSize: Word;
  500.  
  501.    { Return the current font size }
  502.  
  503.    Begin
  504.    Result := Printer.Canvas.Font.Size;
  505.    End;
  506.  
  507. procedure TPrintObject.SetOrientation( Orient: TPrinterOrientation );
  508.  
  509.  
  510.    Begin
  511.    Printer.Orientation := Orient;
  512.                                        
  513.    CalculateMeasurements;
  514.    End;
  515.  
  516. function TPrintObject.CalculateLineHeight: Integer;
  517.  
  518.    { Calculate the height of a line plus the normal amount of space between
  519.      each line }
  520.  
  521.    Begin
  522.    Result := TextMetrics.tmHeight + TextMetrics.tmExternalLeading;
  523.    End;
  524.  
  525. procedure TPrintObject.NewPage;
  526.  
  527.    { Issue a new page }
  528.  
  529.    Begin
  530.    WriteHeader;
  531.    WriteFooter;
  532.    WritePageNumber;
  533.  
  534.    LastYPosition := DetailTop - GetLineHeightInches;
  535.  
  536.    Printer.NewPage;
  537.    End;
  538.  
  539. function TPrintObject.GetPageNumber;
  540.  
  541.    { Return the current page number }
  542.  
  543.    Begin
  544.    Result := Printer.PageNumber;
  545.    End;
  546.  
  547. function TPrintObject.GetTextWidth( Text:String ): Integer;
  548.  
  549.    { Return the width of the text contained in 'Text' in pixels }
  550.  
  551.    Begin
  552.    Result := Printer.Canvas.TextWidth( Text );
  553.    End;
  554.  
  555. function TPrintObject.GetLineHeightPixels: Word;
  556.  
  557.  
  558.    Begin
  559.    Result := CalculateLineHeight;
  560.    End;
  561.  
  562. function TPrintObject.GetLineHeightInches: Single;
  563.  
  564.    Begin
  565.    Result := PixelsToInchesVertical( GetLineHeightPixels );
  566.    End;
  567.  
  568. procedure TPrintObject._DrawBox( XTop:Word; YTop:Word; XBottom:Word; YBottom:Word; LineWidth:Word; Shading:Word );
  569.  
  570.    { The low level routine which actually draws the box and shades it as
  571.      desired. The paramaters are in pixels and not inches. }
  572.  
  573.    Begin
  574.    Printer.Canvas.Pen.Width := LineWidth;
  575.  
  576.    Printer.Canvas.Brush.Color := RGB( Shading,Shading,Shading );
  577.  
  578.    Printer.Canvas.Rectangle( XTop,YTop,XBottom,YBottom );
  579.    End;
  580.  
  581. procedure TPrintObject.DrawBox( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word );
  582.  
  583.    { Draw a box at the X,Y coordinates passed in the parameters }
  584.  
  585.    var
  586.       BLinePixels,BColPixels,ELinePixels,EColPixels: Integer;
  587.  
  588.    Begin
  589.    BLinePixels := InchesToPixelsVertical( YTop ) - GutterTop;
  590.    ELinePixels := InchesToPixelsVertical( YBottom ) - GutterTop;
  591.  
  592.  
  593.    BColPixels := InchesToPixelsHorizontal( XTop ) - GutterLeft;
  594.    EColPixels := InchesToPixelsHorizontal( XBottom ) - GutterLeft;
  595.  
  596.    _DrawBox( BColPixels,BLinePixels,EColPixels,ELinePixels,LineWidth,255 );
  597.    End;
  598.  
  599. procedure TPrintObject.DrawBoxShaded( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word; Shading:Word );
  600.  
  601.    { Draw a box at the X,Y coordinates passed in the parameters }
  602.  
  603.    var
  604.       BLinePixels,BColPixels,ELinePixels,EColPixels: Integer;
  605.  
  606.  
  607.    Begin
  608.    BLinePixels := InchesToPixelsVertical( YTop ) - GutterTop;
  609.    ELinePixels := InchesToPixelsVertical( YBottom ) - GutterTop;
  610.  
  611.    BColPixels := InchesToPixelsHorizontal( XTop ) - GutterLeft;
  612.    EColPixels := InchesToPixelsHorizontal( XBottom ) - GutterLeft;
  613.  
  614.    _DrawBox( BColPixels,BLinePixels,EColPixels,ELinePixels,LineWidth,Shading );
  615.    End;
  616.  
  617. function TPrintObject.GetLinesPerPage: Integer;
  618.  
  619.    { Return the number of lines on the entire page }
  620.  
  621.  
  622.    Begin
  623.    Result := (TotalPageHeightPixels - GutterTop - GutterBottom) Div CalculateLineHeight;
  624.    End;
  625.  
  626. function TPrintObject.GetLinesInDetailArea: Word;
  627.  
  628.    { Return the number of lines in the detail area }
  629.  
  630.    Begin
  631.    Result := InchesToPixelsVertical( DetailBottom - DetailTop ) Div CalculateLineHeight;
  632.    End;
  633.  
  634. procedure TPrintObject.GetPixelsPerInch( var X:Word; var Y:Word );
  635.  
  636.    Begin
  637.    X := PixelsPerInchHorizontal;
  638.    Y := PixelsPerInchVertical;
  639.  
  640.    End;
  641.  
  642. procedure TPrintObject.GetPixelsPerPage( var X:Word; var Y:Word );
  643.  
  644.    Begin
  645.    X := TotalPageWidthPixels - GutterLeft - GutterRight;
  646.    Y := TotalPageHeightPixels - GutterTop - GutterBottom;
  647.    End;
  648.  
  649. procedure TPrintObject.GetGutter( var Top:Word; var Bottom:Word; var Left:Word; var Right:Word );
  650.  
  651.    Begin
  652.    Top := GutterTop;
  653.    Bottom := GutterBottom;
  654.    Left := GutterLeft;
  655.    Right := GutterRight;
  656.    End;
  657.  
  658. procedure TPrintObject.Abort;
  659.  
  660.    Begin
  661.  
  662.    Printer.Abort;
  663.    End;
  664.  
  665. function TPrintObject.GetColumnsPerLine: Integer;
  666.  
  667.    { How many columns are there in a Line? }
  668.  
  669.    var
  670.       Pixels: Integer;
  671.  
  672.    Begin
  673.    Pixels := TotalPageWidthPixels - GutterLeft - GutterRight;
  674.  
  675.    Result := Pixels Div Printer.Canvas.TextWidth( 'B' );      
  676.    End;  
  677.  
  678. function TPrintObject.InchesToPixelsHorizontal( Inches: Single ): Integer;
  679.  
  680.    { Convert the horizontal inches represented in 'Inches' to pixels }
  681.  
  682.    var
  683.  
  684.       Value: Single;
  685.       Buffer: String;
  686.       I: Integer;
  687.                   
  688.    Begin
  689.    Value := Inches * PixelsPerInchHorizontal;
  690.    Buffer := FloatToStr( Value );
  691.  
  692.    { If there is a decimal point in 'Buffer', remove it. }
  693.    I := 1;
  694.    While( (Buffer[I] <> '.') And (I <= Length(Buffer)) ) Do
  695.       Inc( I );
  696.    Buffer[0] := Chr( I-1 );
  697.  
  698.    Result := StrToInt( Buffer );
  699.    End;
  700.  
  701. function TPrintObject.InchesToPixelsVertical( Inches: Single ): Integer;
  702.  
  703.  
  704.    { Convert the vertical inches represented in 'Inches' to pixels }
  705.  
  706.    var
  707.       Value: Single;
  708.       Buffer: String;
  709.       I: Integer;
  710.                   
  711.    Begin
  712.    Value := Inches * PixelsPerInchVertical;
  713.    Buffer := FloatToStr( Value );
  714.  
  715.       { If there is a decimal point in 'Buffer', remove it. }
  716.    I := 1;
  717.    While( (Buffer[I] <> '.') And (I <= Length(Buffer)) ) Do
  718.       Inc( I );
  719.    Buffer[0] := Chr( I-1 );
  720.  
  721.    Result := StrToInt( Buffer );
  722.    End;
  723.  
  724.  
  725. function TPrintObject.PixelsToInchesHorizontal( Pixels: Integer ): Single;
  726.  
  727.    Begin
  728.    Result := Pixels / PixelsPerInchHorizontal;
  729.    End;
  730.  
  731. function TPrintObject.PixelsToInchesVertical( Pixels: Integer ): Single;
  732.  
  733.    Begin
  734.    Result := Pixels / PixelsPerInchVertical;
  735.    End;
  736.  
  737. function TPrintObject.LinesToPixels( Line:Integer ): Integer;
  738.  
  739.    { Calculate the number of vertical pixels in 'Line' }
  740.  
  741.    Begin
  742.    If ( Line <= 0 ) Then
  743.       Line := 1;
  744.  
  745.    Result := (Line-1) * CalculateLineHeight;
  746.  
  747.    End;
  748.  
  749. procedure TPrintObject.SetLineWidth( Width:Word );
  750.  
  751.    Begin
  752.    Printer.Canvas.Pen.Width := Width;
  753.    End;
  754.  
  755. function TPrintObject.GetLineWidth: Word;
  756.  
  757.    Begin
  758.    Result := Printer.Canvas.Pen.Width;
  759.    End;
  760.  
  761. procedure TPrintObject.CalculateMeasurements;
  762.  
  763.    { Calculate some necessary measurements.  Thanks to Robert Fabiszak
  764.      CompuServe: 70304,2047 for the Escape() Windows API calls. }
  765.  
  766.    var
  767.       pt: TPoint;
  768.  
  769.    Begin
  770.    { Call the Windows API function GetTextMetrics() to get the specifics
  771.  
  772.      of the particular font. }
  773.    GetTextMetrics( Printer.Canvas.Handle,TextMetrics );
  774.  
  775.    { Calculate the number of pixels per inch vertical and horizontal.
  776.      'GetDeviceCaps' is a Windows API call. }
  777.    PixelsPerInchVertical := GetDeviceCaps( Printer.Handle,LOGPIXELSY );
  778.    PixelsPerInchHorizontal := GetDeviceCaps( Printer.Handle,LOGPIXELSX );
  779.  
  780.    { Get the gutter on the left and top.  'Escape' is a Windows API 
  781.      call. }
  782.    Escape( Printer.Canvas.Handle,GETPRINTINGOFFSET,0,Nil,@pt );
  783.  
  784.    GutterLeft := pt.X;
  785.    GutterTop := pt.Y;
  786.  
  787.    Escape( Printer.Canvas.Handle,GETPHYSPAGESIZE,0,Nil,@pt );
  788.    TotalPageWidthPixels := pt.X;
  789.    TotalPageHeightPixels := pt.Y;
  790.    TotalPageWidthInches := pt.X / PixelsPerInchHorizontal;
  791.    TotalPageHeightInches := pt.Y / PixelsPerInchVertical;
  792.  
  793.    GutterRight := TotalPageWidthPixels - GutterLeft - Printer.PageWidth;
  794.    GutterBottom := TotalPageHeightPixels - GutterTop - Printer.PageHeight;
  795.  
  796.    If ( TopMargin < GutterTop ) Then
  797.  
  798.       TopMargin := GutterTop;
  799.    If ( BottomMargin < GutterBottom ) Then
  800.       BottomMargin := GutterBottom;
  801.    If ( LeftMargin < GutterLeft ) Then
  802.       LeftMargin := GutterLeft;
  803.    If ( RightMargin < GutterRight ) Then
  804.       RightMargin := GutterRight;   
  805.    End;
  806.  
  807. procedure TPrintObject.SetHeaderInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word; 
  808.    FontName:String; FontSize: Word; FontStyle: TFontStyles );
  809.  
  810.    Begin
  811.    If ( Line > HeaderLines ) Then
  812.  
  813.       Exit;
  814.  
  815.    Header[Line].Text := Text;
  816.    Header[Line].YPosition := YPosition;
  817.    Header[Line].Alignment := Alignment;
  818.    Header[Line].FontName := FontName;
  819.    Header[Line].FontSize := FontSize;
  820.    Header[Line].FontStyle := FontStyle;   
  821.    End;
  822.  
  823. procedure TPrintObject.SetFooterInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word; 
  824.    FontName:String; FontSize: Word; FontStyle: TFontStyles );
  825.  
  826.    Begin
  827.    If ( Line > FooterLines ) Then
  828.  
  829.       Exit;
  830.  
  831.    Footer[Line].Text := Text;
  832.    Footer[Line].YPosition := YPosition;
  833.    Footer[Line].Alignment := Alignment;
  834.    Footer[Line].FontName := FontName;
  835.    Footer[Line].FontSize := FontSize;
  836.    Footer[Line].FontStyle := FontStyle;   
  837.    End;
  838.  
  839. procedure TPrintObject.WriteHeader;
  840.  
  841.    { If any headers are defined, write them }
  842.  
  843.    var
  844.       I: Integer;
  845.  
  846.    Begin
  847.    SaveCurrentFont;
  848.    For I := 1 To HeaderLines Do
  849.       Begin
  850.       If ( Length(Header[I].Text) > 0 ) Then
  851.  
  852.          Begin
  853.          With Header[I] Do
  854.             Begin
  855.             SetFontInformation( FontName,FontSize,FontStyle );
  856.             If ( Alignment = 0 ) Then
  857.                WriteLine( LeftMargin, YPosition, Text );
  858.             If ( Alignment = 1 ) Then
  859.                WriteLineCenter( YPosition, Text );
  860.             If ( Alignment = 2 ) Then
  861.                WriteLineRight( YPosition, Text );
  862.             End;
  863.          End;
  864.  
  865.       RestoreCurrentFont;
  866.       End;
  867.  
  868.  
  869.    { Does the user desire a box around the header? }
  870.    If ( HeaderCoordinates.Boxed = True ) Then
  871.       Begin
  872.       If ( HeaderCoordinates.Shading > 0 ) Then
  873.          DrawBoxShaded( HeaderCoordinates.XTop,HeaderCoordinates.YTop,HeaderCoordinates.XBottom,
  874.             HeaderCoordinates.YBottom,HeaderCoordinates.LineWidth,HeaderCoordinates.Shading )
  875.       Else
  876.          DrawBox( HeaderCoordinates.XTop,HeaderCoordinates.YTop,HeaderCoordinates.XBottom,
  877.             HeaderCoordinates.YBottom,HeaderCoordinates.LineWidth );
  878.  
  879.       End;
  880.    End;
  881.  
  882. procedure TPrintObject.WriteFooter;
  883.  
  884.    { If any footers are defined, write them }
  885.  
  886.    var
  887.       I: Integer;
  888.       Temp: Boolean;
  889.  
  890.    Begin
  891.    SaveCurrentFont;
  892.  
  893.    { Set 'AutoPaging' off.  Otherwise the footer will not get written
  894.      correctly. }
  895.    Temp := AutoPaging;
  896.    AutoPaging := False;
  897.       
  898.    For I := 1 To FooterLines Do
  899.       Begin
  900.       If ( Length(Footer[I].Text) > 0 ) Then
  901.          Begin
  902.          With Footer[I] Do
  903.  
  904.             Begin
  905.             SetFontInformation( FontName,FontSize,FontStyle );
  906.             If ( Alignment = 0 ) Then
  907.                WriteLine( LeftMargin, YPosition, Text );
  908.             If ( Alignment = 1 ) Then
  909.                WriteLineCenter( YPosition, Text );
  910.             If ( Alignment = 2 ) Then
  911.                WriteLineRight( YPosition, Text );
  912.             End;
  913.          End;
  914.  
  915.       RestoreCurrentFont;
  916.       End;
  917.  
  918.    { Does the user desire a box around the footer? }
  919.  
  920.    If ( FooterCoordinates.Boxed = True ) Then
  921.       Begin
  922.       If ( FooterCoordinates.Shading > 0 ) Then
  923.          DrawBoxShaded( FooterCoordinates.XTop,FooterCoordinates.YTop,FooterCoordinates.XBottom,
  924.             FooterCoordinates.YBottom,FooterCoordinates.LineWidth,FooterCoordinates.Shading )
  925.       Else
  926.          DrawBox( FooterCoordinates.XTop,FooterCoordinates.YTop,FooterCoordinates.XBottom,
  927.             FooterCoordinates.YBottom,FooterCoordinates.LineWidth );
  928.       End;
  929.  
  930.  
  931.    AutoPaging := Temp;
  932.    End;
  933.  
  934. procedure TPrintObject.SaveCurrentFont;
  935.  
  936.    Begin
  937.    CurrentFontName := Printer.Canvas.Font.Name;
  938.    CurrentFontSize := Printer.Canvas.Font.Size;
  939.    CurrentFontStyle := Printer.Canvas.Font.Style;
  940.    End;                                       
  941.  
  942. procedure TPrintObject.RestoreCurrentFont;
  943.  
  944.    Begin
  945.    SetFontInformation( CurrentFontName,CurrentFontSize,CurrentFontStyle );
  946.    End;
  947.  
  948. procedure TPrintObject.SetDetailTopBottom( Top: Single; Bottom: Single );
  949.  
  950.  
  951.    Begin
  952.    DetailTop := Top;
  953.    DetailBottom := Bottom;
  954.  
  955.    LastYPosition := Top - GetLineHeightInches;
  956.    End;
  957.  
  958. procedure TPrintObject.SetAutoPaging( Value: Boolean );
  959.  
  960.    Begin
  961.    AutoPaging := Value;
  962.    End;
  963.  
  964. procedure TPrintObject.SetPageNumberInformation( YPosition:Single; Text:String; Alignment:Word; FontName:String; 
  965.    FontSize:Word; FontStyle:TFontStyles );
  966.  
  967.    Begin
  968.    PageNumber.Text := Text;
  969.    PageNumber.YPosition := YPosition;
  970.    PageNumber.Alignment := Alignment;
  971.  
  972.    PageNumber.FontName := FontName;
  973.    PageNumber.FontSize := FontSize;
  974.    PageNumber.FontStyle := FontStyle;
  975.    End;
  976.  
  977. procedure TPrintObject.WritePageNumber;
  978.  
  979.    var
  980.       Buffer: String;
  981.       Temp: Boolean;
  982.  
  983.    Begin
  984.    Buffer := Format( PageNumber.Text,[Printer.PageNumber] );
  985.  
  986.    SaveCurrentFont;
  987.    SetFontInformation( PageNumber.FontName,PageNumber.FontSize,PageNumber.FontStyle );
  988.  
  989.    Temp := AutoPaging;
  990.    AutoPaging := False;
  991.                                    
  992.  
  993.    If ( PageNumber.Alignment = 0 ) Then
  994.       WriteLine( LeftMargin, PageNumber.YPosition, Buffer );
  995.    If ( PageNumber.Alignment = 1 ) Then
  996.       WriteLineCenter( PageNumber.YPosition, Buffer );
  997.    If ( PageNumber.Alignment = 2 ) Then
  998.       WriteLineRight( PageNumber.YPosition, Buffer );
  999.  
  1000.    AutoPaging := Temp;
  1001.  
  1002.    RestoreCurrentFont;
  1003.    End;
  1004.  
  1005. procedure TPrintObject.SetTab( Inches:Single );
  1006.  
  1007.    Begin
  1008.    CurrentTab := Inches;
  1009.    End;
  1010.  
  1011. procedure TPrintObject.SetHeaderDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
  1012.  
  1013.    Boxed: Boolean; LineWidth:Word; Shading:Word );
  1014.  
  1015.    Begin
  1016.    HeaderCoordinates.XTop := XTop;
  1017.    HeaderCoordinates.XBottom := XBottom;
  1018.    HeaderCoordinates.YTop := YTop;
  1019.    HeaderCoordinates.YBottom := YBottom;
  1020.    HeaderCoordinates.Boxed := Boxed;
  1021.    HeaderCoordinates.LineWidth := LineWidth;
  1022.    HeaderCoordinates.Shading := Shading;
  1023.    End;
  1024.  
  1025. procedure TPrintObject.SetFooterDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
  1026.    Boxed: Boolean; LineWidth:Word; Shading:Word );
  1027.  
  1028.  
  1029.    Begin
  1030.    FooterCoordinates.XTop := XTop;
  1031.    FooterCoordinates.XBottom := XBottom;
  1032.    FooterCoordinates.YTop := YTop;
  1033.    FooterCoordinates.YBottom := YBottom;
  1034.    FooterCoordinates.Boxed := Boxed;
  1035.    FooterCoordinates.LineWidth := LineWidth;
  1036.    FooterCoordinates.Shading := Shading;
  1037.    End;
  1038.  
  1039. procedure TPrintObject.CreateColumn( Number:Word; XPosition:Single; Length:Single );
  1040.  
  1041.    Begin
  1042.    ColumnInformation[Number].XPosition := XPosition;
  1043.    ColumnInformation[Number].Length := Length;
  1044.  
  1045.    End;
  1046.  
  1047. procedure TPrintObject.SetYPosition( YPosition:Single );
  1048.  
  1049.    Begin
  1050.    LastYPosition := YPosition;
  1051.    End;
  1052.     
  1053. function TPrintObject.GetYPosition: Single;
  1054.  
  1055.    Begin
  1056.    Result := LastYPosition;
  1057.    End;
  1058.  
  1059. procedure TPrintObject.NextLine;
  1060.  
  1061.    Begin
  1062.    LastYPosition := LastYPosition + GetLineHeightInches;
  1063.    End;   
  1064.  
  1065. function TPrintObject.GetLinesLeft: Word;
  1066.  
  1067.    { Return the number of lines left in the detail area }
  1068.  
  1069.    var
  1070.       Lines: Single;
  1071.  
  1072.       Buffer: String[20];
  1073.       I: Word;
  1074.  
  1075.    Begin
  1076.    Lines := (DetailBottom - LastYPosition) / GetLineHeightInches;
  1077.    Buffer := FloatToStr( Lines );
  1078.  
  1079.    { Buffer contains the number of lines left as a floating point number.
  1080.      Find the decimal and truncate the string at that point.  So, if there
  1081.      are 2.99 lines left, 2 will be returned.  Better to be conservative. }
  1082.    For I := 1 To Length(Buffer) Do
  1083.       Begin
  1084.       If ( Buffer[I] = '.' ) Then
  1085.          Begin
  1086.  
  1087.          Buffer[0] := Chr(I-1);
  1088.          Break;
  1089.          End;
  1090.       End;
  1091.  
  1092.    Result := StrToInt( Buffer );
  1093.    End;
  1094.  
  1095. procedure TPrintObject.SetTopOfPage;
  1096.  
  1097.    Begin
  1098.    LastYPosition := DetailTop;
  1099.    End;
  1100.  
  1101. procedure TPrintObject.NewLines( Number:Word );
  1102.  
  1103.    { Generate the number of line feeds represented in 'Number' }
  1104.  
  1105.    var
  1106.       I: Word;
  1107.  
  1108.    Begin
  1109.    For I := 1 To Number Do
  1110.       NextLine;
  1111.    End;
  1112.  
  1113. end.
  1114.  
  1115.